home *** CD-ROM | disk | FTP | other *** search
/ BMUG PD-ROM 1995 Fall / PD-ROM F95.toast / Utilities / Text Utils / Alpha 5.81 ƒ / Tcl / SystemCode / modes.tcl < prev    next >
Encoding:
Text File  |  1994-06-14  |  6.9 KB  |  315 lines  |  [TEXT/ALFA]
  1. set localVars { optionIsMeta wordBreak wordBreakPreface wordWrap 
  2.     fillColumn leftFillColumn tabSize elecLBrace elecRBrace electricSemi 
  3.     prefixString suffixString funcExpr funcPar sortedIsDefault 
  4.     markSorting }
  5.  
  6.  
  7.  
  8.  
  9. set allModeMenus {     thinkMenu cwarrierMenu toolserverMenu
  10.                     texMenu thinkRefMenu oztexMenu 
  11.                     texturesMenu tclMenu perlMenu }
  12.  
  13.  
  14. set modeMenus(C)         { thinkMenu cwarrierMenu thinkRefMenu }
  15. set modeMenus(C++)         { thinkMenu cwarrierMenu thinkRefMenu }
  16. set modeMenus(TeX)         { texMenu texturesMenu }
  17. set modeMenus(Text)        { perlMenu }
  18. set modeMenus(Fort)     { }
  19. set modeMenus(Tcl)         { tclMenu }
  20. set modeMenus(MPW)         { }
  21. set modeMenus(Csh)         { tclMenu }
  22. set modeMenus(BRWZ)     { }
  23.  
  24.  
  25. # 'modes' is inspected by alpha for the popup mode menu. 'newMode' is 
  26. # called by Alpha in case of a successful choice.
  27. set modes { C C++ Csh Fort MPW Tcl TeX Text }
  28.  
  29. set modeProcs(C)         setCMode
  30. set modeProcs(C++)         setC++Mode
  31. set modeProcs(Csh)         setShellMode
  32. set modeProcs(Fort)     setFortranMode
  33. set modeProcs(MPW)         setMPWMode
  34. set modeProcs(Tcl)         setTclMode
  35. set modeProcs(TeX)         setTexMode
  36. set modeProcs(Text)     setTextMode
  37.  
  38.  
  39. set lastMode 0
  40.  
  41.  
  42.  
  43. #================================================================================
  44.  
  45.  
  46. proc setWinMode name {
  47.     global winModes
  48.     set nm [file tail $name]
  49.     if {[set first [string last " <" $name]] >= 0} {
  50.         set rname [string range $name 0 [expr $first - 1]]
  51.     } else {
  52.         set rname $name
  53.     }
  54.     case $rname in {
  55.         "*.c"         {     set winModes($name) setCMode }
  56.         "*.tex"        {     set winModes($name) setTexMode; winFuncTitle $nm "Sect" }
  57.         "*.cc"        {     set winModes($name) setC++Mode; winFuncTitle $nm "Meth" }
  58.         "*.cp"        {     set winModes($name) setC++Mode; winFuncTitle $nm "Meth" }
  59.         "*.C"        {     set winModes($name) setC++Mode; winFuncTitle $nm "Meth" }
  60.         "*.h"         {     set winModes($name) setCMode }
  61.         "*.f"          {     set winModes($name) setFortranMode }
  62.         "*.tcl"     {     set winModes($name) setTclMode; winFuncTitle $nm "Proc" }
  63.         {*Toolserver\ sh*}    {     set winModes($name) setMPWMode; winFuncTitle $nm "Proc" }
  64.         {*tcl\ sh*}    {     set winModes($name) setShellMode; winFuncTitle $nm "Proc" }
  65.         "*.sty"        {     set winModes($name) setTexMode; winFuncTitle $nm "Sect" }
  66.         "Browser"    {     set winModes($name) setBrowseMode }
  67.         default        {     set winModes($name) setTextMode }
  68.     }
  69. }
  70.  
  71.  
  72.  
  73. proc newMode mode {
  74.     global winModes
  75.     global modeProcs
  76.     
  77.     set name [lindex [winNames -f] 0]
  78.     $modeProcs($mode)
  79.     set winModes($name) $modeProcs($mode)
  80. }
  81.  
  82.  
  83. proc deactivateHook name {
  84. }
  85.  
  86. proc suspendHook name {
  87.     global iconifyOnSwitch
  88.     global suspIconed
  89.     if {$iconifyOnSwitch} {
  90.         set wins [winNames -f]
  91.         foreach win $wins {
  92.             if {![icon -f "$win" -q]} {
  93.                 set suspIconed($win) 1
  94.                 icon -f "$win" -t
  95.             }
  96.         }
  97.     }
  98. }
  99.  
  100. proc resumeHook name {
  101.     global iconifyOnSwitch resumeRevert suspIconed
  102.     if {$iconifyOnSwitch && [info exists suspIconed]} {
  103.         set wins [winNames -f]
  104.         foreach win [array names suspIconed] {
  105.             icon -f "$win" -o
  106.         }
  107.         unset suspIconed
  108.     }
  109.     if {$resumeRevert} {
  110.         set resumeRevert 0
  111.         revert
  112.     }
  113. }
  114.  
  115. # Called prior to Alpha calling 'MenuSelect'. Redefined in 'flags.tcl'.
  116. proc menuHook {} {
  117.     
  118. }
  119.  
  120.  
  121. # Handles dynamically adding and deleting window names from menu.
  122. proc addWinName name {
  123.     global winNameToNum winMenu winNumToName fullNames
  124.     
  125.     for {set i 0} {$i<100} {incr i} {
  126.         if {[catch {set nm $winNumToName($i)} res] == "1"} {
  127.             if {$fullNames != "0"} {
  128.                 set nm $name
  129.             } else {
  130.                 regexp {[^:]*$} $name nm
  131.             }
  132.             if {$i < 10} {
  133.                 addMenuItem -m -l "/$i" $winMenu $nm
  134.             } else {
  135.                 addMenuItem -m -l "" $winMenu $nm
  136.             }
  137.             set winNumToName($i) $name
  138.             set winNameToNum($name) $i
  139.             return
  140.         }
  141.     }
  142. }
  143.  
  144. proc removeWinName name {
  145.     global winNameToNum winNumToName fullNames winMenu
  146.     
  147.     set num $winNameToNum($name)
  148.     unset winNumToName($num)
  149.     unset winNameToNum($name)
  150.     if {$fullNames == "1"} {
  151.         deleteMenuItem -m $winMenu $name
  152.     } else {
  153.         regexp {[^:]*$} $name nm
  154.         deleteMenuItem -m $winMenu $nm
  155.     }
  156. }
  157.  
  158.  
  159. proc menuWin {menu name} {
  160.     global winNameToNum
  161.  
  162.     set nms [array names winNameToNum]
  163.     foreach nm $nms {
  164.         if {[string match *$name $nm] == "1"}  {
  165.             bringToFront $name
  166.             if [icon -q] { icon -f $name -o }
  167.             return
  168.         }
  169.     }
  170.     return "normal"
  171. }
  172.  
  173.  
  174.  
  175. proc changeMode {newMode} {
  176.     global lastMode savedIsMeta wordBreak wordBreakPreface optionIsMeta modeMenus
  177.     
  178.     catch {displayMode $newMode}
  179.     if {$lastMode == $newMode} return
  180.     
  181.     if { $lastMode == "TeX" } {
  182.         set optionIsMeta $savedIsMeta
  183.         set wordBreakPreface {[^a-zA-Z0-9_]}
  184.         set wordBreak {[a-zA-Z0-9_]+}
  185.         set optionIsMeta 1
  186.     }
  187.     
  188.     if {[info exists modeMenus($lastMode)]} {
  189.         foreach m $modeMenus($lastMode) {
  190.             global $m
  191.             catch {removeMenu [set $m]}
  192.         }
  193.     }
  194.  
  195.     global mode
  196.     set mode $newMode
  197.     set lastMode $newMode
  198.  
  199.     if {[info exists modeMenus($lastMode)]} {
  200.         foreach m $modeMenus($lastMode) {
  201.             global $m
  202.             catch {insertMenu [set $m]}
  203.         }
  204.     }
  205. }
  206.  
  207.  
  208. proc setModeMenus {} {
  209.     global mode modeMenus allModeMenus
  210.  
  211.     set menus [listpick -p "Select (using shift) menus for mode '$mode':" -l [lsort $allModeMenus]]
  212.     if {![llength $menus]} return
  213.     set modeMenus($mode) $menus
  214.     addUserLine "set modeMenus($mode) \{ $menus \}"
  215.  
  216.     foreach m $allModeMenus {
  217.         global $m
  218.         catch {removeMenu [set $m]}
  219.     }
  220.     foreach m $menus {
  221.         global $m
  222.         catch {insertMenu [set $m]}
  223.     }
  224. }
  225.  
  226.  
  227. # Modes
  228.  
  229. # Fortran programming mode 
  230. proc setFortranMode {} {
  231.     changeMode "Fort"
  232.     uplevel #0 {
  233.         set elecLBrace 0
  234.         set elecRBrace 0
  235.         set electricSemi 0
  236.         set wordWrap 0
  237.         set funcExpr {^(      |\t)(subroutine|.*function|SUBROUTINE|.*FUNCTION).*\(.*$}
  238.         set sortedIsDefault 0
  239.     }
  240. }
  241.  
  242.  
  243. # Ordinary, default mode
  244. proc setTextMode {} {
  245.     changeMode "Text"
  246.     uplevel #0 {
  247.         set elecLBrace 0
  248.         set elecRBrace 0
  249.         set electricSemi 0
  250.         set wordWrap 1
  251.         set prefixString "> "
  252.         set suffixString " <--"
  253.     }
  254. }
  255.  
  256. #=============================================================================
  257. # Hook procs recognized: "openHook", "closeHook", "activateHook", "deactivateHook", 
  258. #                          "suspendHook", "saveasHook", "saveHook", and "resumeHook".
  259. #=============================================================================
  260.  
  261. # Event hooks - set specific modes when files opened.
  262. proc openHook name {
  263.     global winModes
  264.     $winModes($name)
  265.     if {$name == {*Toolserver shell*}} startMPW
  266.     addWinName $name
  267. }
  268.  
  269. # full pathname
  270. proc saveHook name {
  271.     global backup backExtension backDir
  272.     if {![string length [set dir $backDir]]} {
  273.         set dir [file dirname $name]
  274.     }
  275.     if ($backup) {
  276.         catch {rm $dir:[file tail $name]~}
  277.         cp $name $dir:[file tail $name]$backExtension
  278.     }
  279. }
  280.  
  281. # Clean up the mark stack.
  282. proc closeHook name {
  283.     global markStack
  284.     global winModes
  285.     unset winModes($name)
  286.     if [llength $markStack] {
  287.         set markStack [removePat $markStack $name*]
  288.     }
  289.     removeWinName $name
  290. }
  291.  
  292. proc saveasHook {oldName newName} {
  293.     global winModes
  294.     removeWinName $oldName
  295.     addWinName $newName
  296.     setWinMode $newName
  297.     $winModes($newName)
  298. }
  299.  
  300.  
  301. proc activateHook name {
  302.     global winModes
  303.     if {[catch {$winModes($name)}]} {
  304.         setWinMode $name
  305.         $winModes($name)
  306.     }
  307. }
  308.  
  309. proc dirtyHook {name dirty} {
  310.     global winMenu
  311.     markMenuItem $winMenu [file tail $name] $dirty "◊"
  312. }
  313.  
  314.  
  315.